******************************** * Long Peek, Poke, and Call * * by Tom Peng * * * * Copyright (C) 1992 by * * MindCraft Publishing Corp. * * Lincoln, MA 01773 * ******************************** keep lplplc msb on ;keep most sig. bit on org $8000 ampvect gequ $3f5 ;Ampersand jump vector chargot gequ $00b7 ;Get current char charget gequ $00b1 ;Get next char synchr gequ $dec0 ;Print SYNTAX ERROR frmevl gequ $dd7b ;Formula evaluator conint gequ $e6fb ;Convert FAC to integer chkcom gequ $debe ;Check for comma getadr gequ $e752 ;Convert FAC to 2 byte integer ptrget gequ $dfe3 ;Address of variable into Y,A cout gequ $fded ;Print character varpnt gequ $83 ;Address returned by ptrget ($83/$84) linnum gequ $50 ;Address returned by getadr ($50/$51) addr gequ $0 ;Temp. storage bank gequ $2 ;Temp. storage number gequ $4 ;Temp. storage longi off ;8 bit A,X,Y longa off setup start lda #$4c ;Set up ampersand vector sta ampvect lda #begin sta ampvect+2 ldy #0 nextchar lda message,y ;Print init. message cmp #0 beq stop jsr cout iny jmp nextchar stop rts ; ------------------------------- begin anop ;Actual handling routine starts here jsr chargot ;Get current char after "&" cmp #$e2 ;Check if "PEEK" token found beq peek ;Yes, branch! cmp #$b9 ;Check if "POKE" token found beq poke ;Yes, branch! cmp #$8c ;Check if "CALL" token found beq call ;Yes, branch! jmp synerr ;Syn. err. occured poke jsr charget ;Skip POKE token jsr frmevl ;Evaluating value for bank jsr conint ;Convert result to integer stx bank ;Put integer in bank jsr chkcom ;Check for comma jsr frmevl ;Evalute value for address jsr getadr ;Convert result into 2 byte integer lda linnum ;put first byte in storage sta addr lda linnum+1 ;put second byte in storage sta addr+1 jsr chkcom ;Check for comma jsr frmevl ;Evaluate value for number jsr conint ;Convert to integer stx number ;put it in number longi on ;16 bit A,X,Y longa on rep #$30 lda number ;Get number sta [addr] ;Put it in destinate location sep #$30 ;8 bit A,X,Y longi off longa off rts ;To applesoft peek jsr charget ;Skip PEEK token jsr frmevl ;Evaluate value for bank jsr conint ;Convert into integer stx bank ;store it in bank jsr chkcom ;check for comma jsr frmevl ;Evaluate value for address jsr getadr ;Convert to 2 byte integer lda linnum ;put first byte in storage sta addr lda linnum+1 ;put second byte in storage sta addr+1 longi on ;16 bit A,X,Y longa on rep #$30 lda [addr] ;Get result from destinate location sep #$30 ;8 bit A,X,Y longa off longi off pha ;Push result jsr chkcom ;Check for comma jsr ptrget ;Find the address of variable ldy #$0 lda #$0 sta (varpnt),y iny pla sta (varpnt),y ;Put result into address rts ;To applesoft call jsr charget ;Skip CALL token jsr frmevl ;Evaluate value for bank jsr conint ;Convert to integer stx ljump+3 ;Put it somewhere jsr chkcom ;Check for comma jsr frmevl ;Evaluate value for address jsr getadr ;Convert to 2 byte integer lda linnum ;put lo-byte somewhere sta ljump+1 lda linnum+1 ;put hi-byte somewhere sta ljump+2 jsr chkcom ;Check for comma jsr frmevl ;Evaluate for Accumulator jsr conint ;Convert to integer cpx #2 ;Less than 2? bpl synerr ;No! So error stx rega ;Put in rega jsr chkcom ;Check for comma jsr frmevl ;Evaluate for index registers jsr conint ;convert to integer cpx #2 ;Less than 2? bpl synerr ;No! So ERROR stx regi ;Put in regi jsr chkcom ;Check for coma jsr frmevl ;Evaluate for mode jsr conint ;Convert to integer cpx #2 ;Less than 2? bpl synerr ;No! So ERROR stx eflag ;put in eflag lda rega ;Get rega cmp #1 ;Equal to 1? beq tregi ;Yes! Goto tregi rep #$20 ;Set 16 bit accumulator tregi lda regi ;Get regi cmp #1 ;Equal to 1? beq teflag ;Yes! Goto teflag rep #$10 ;Set 16 bit index register teflag lda eflag ;Get eflag cmp #1 ;Equal to 1? beq ljump ;Yes! Goto ljump clc ;Set native mode xce ljump jsl $ffffff ;Jump to destinate location sec ;8 bit A,X,Y and emulation mode xce sep #$30 rts ;To applesoft synerr lda #$ff ;Display ?SYNTAX ERROR message jmp synchr message dc c'Long Peek, Poke, and Call',h'8d' dc c'ampersand routine installed',h'8d8d' dc c'by Tom Peng',h'8d' dc c'Copyright (C) 1992, MindCraft Publ.',h'8d8d00' rega ds 2 regi ds 2 eflag ds 2 end